perm filename PTRBIN[D,SYS] blob sn#195724 filedate 1977-05-16 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	PTRBIN	- TEST PTR BINARY MODE.
C00006 ENDMK
C⊗;
	TITLE	PTRBIN	- TEST PTR BINARY MODE.

PTR←←1
PTP←←2

A←1
B←2
C←3
D←4

BINWRD:	0
BINBYT:	0

OBUF:	BLOCK	3
IBUF:	BLOCK	3


BEGIN:	RESET
	OUTSTR	[ASCIZ/TYPE Y TO PUNCH A TEST TAPE: /]
	INCHWL	A
	CLRBFI
	CAIE	A,"Y"
	CAIN	A,"Y"+40
	JRST	PNCHT
RT:	SETOM	REALBI#		;ASSUME REAL BINARY.
	OUTSTR	[ASCIZ/
MOUNT TAPE IN READER.  TYPE CR TO CONTINUE.  TYPE Y TO SIMULATE BINARY MODE.  /]
	INCHWL	A
	CAIE	A,"Y"
	CAIN	A,"Y"+40
	SETZM	REALBI		;SIMULATE
	CLRBFI
	INIT	PTR,13
	'PTR   '
	IBUF
	HALT	RT
	INBUF	PTR,2
	SKIPN	REALBI
	SETSTS	PTR,10		;SIMULATE BINARY MODE
	MOVE	A,[POINT 6,BINWRD]
	MOVEM	A,BINBYT
	JSR	PATINI
RLOOP:	JSR	PATGEN				;GENERATE A WORD.  SKIPS UNLESS EOF
	JRST	REOF
	JSR	RTAPE				;READ A WORD FROM THE TAPE
	JRST	UEOF
	CAMN	A,B
	JRST	RLOOP
	OUTSTR	[ASCIZ/FAILED.  CORRECT WORD IN A.  WORD READ IN B.
/]
STOP:	JRST	RLOOP

UEOF:	OUTSTR	[ASCIZ/PREMATURE END OF TAPE.
/]
	HALT	RT

REOF:	JSR	RTAPE
	JRST	TAPOK
	OUTSTR	[ASCIZ/TAPE TOO LONG
/]
	HALT	REOF

XEOF:	OUTSTR	[ASCIZ/EOF WHEN A PARTIAL WORD HAD BEEN ACCUMULATED.
/]
	HALT	BEGIN

TAPOK:	MOVE	B,BINBYT
	CAME	B,[POINT 6,BINWRD]
	JRST	XEOF
	OUTSTR	[ASCIZ/TAPE OK
/]
	CLOSE	PTR,
	RELEAS	PTR,
	JRST	RT


RTAPE:	0
RTAP0:	SOSG	IBUF+2
	IN	PTR,
	JRST	RTAP1
	STATZ	1,760000
	JRST	@RTAPE			;EOF.
	OUTSTR	[ASCIZ/TAPE INPUT ERROR.
/]
	HALT	.+1
	SETSTS	PTR,13
	JRST	RTAP0

RTAP1:	ILDB	B,IBUF+1
	SKIPN	REALBI		;SKIP IF DOING REAL BINARY MODE.
	JRST	RTAP2		;SIMULATED BINARY MODE
	AOS	RTAPE
	JRST	2,@RTAPE

RTAP2:	TRNE	B,200		;SKIP IF HOLE 8 OFF (REJECT)
	TRNE	B,100		;SKIP IF HOLE 7 OFF (ACCEPT)
	JRST	RTAP0		;REJECT BYTE.
	IDPB	B,BINBYT	;STORE BYTE
	MOVE	B,BINBYT
	CAME	B,[POINT 6,BINWRD,35]	;WORD READY YET?
	JRST	RTAP0		;NO.
	MOVE	B,[POINT 6,BINWRD]	;YES. RESET BYTE POINTER
	MOVEM	B,BINBYT
	MOVE	B,BINWRD
	AOS	RTAPE
	JRST	2,@RTAPE


PNCHT:	INIT	PTP,13
	'PTP   '
	OBUF,,
	HALT	PNCHT
	OUTBUF	PTP,2
	JSR	PATINI
PLOOP:	JSR	PATGEN			;GENERATE A WORD.  SKIPS UNLESS EOF
	JRST	PEOF			;TIME TO CLOSE PTP
	JSR	PTAPE			;READ A WORD FROM THE TAPE
	JRST	PLOOP

PEOF:	CLOSE	PTP,
	RELEAS	PTP,
	JRST	RT

PTAPE:	0
	SOSG	OBUF+2
	OUTPUT	PTP,
	IDPB	A,OBUF+1
	JRST	@PTAPE

PATINI:	0
	MOVEI	A,1
	MOVEM	A,PAT#
	SETOM	WRC#
	JRST	@PATINI

PATGEN:	0
	AOS	A,WRC
	CAILE	A,=2000
	JRST	@PATGEN
	AOS	PATGEN
	TRNE	A,37			;NON ZERO WORDS ONLY AT MULTIPLES OF 40
	JRST	[MOVEI A,0
		JRST @PATGEN]
	MOVE	A,PAT
	ROT	A,1
	TLNN	A,400000
	TRC	A,1
	SETCAM	A,PAT
	JRST	@PATGEN

END BEGIN